home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 93win / data1.cab / Lexical_Order_files / LABELCHR.BAS < prev    next >
Encoding:
BASIC Source File  |  2005-03-02  |  3.6 KB  |  172 lines
  1. 10 !RE-SAVE"LABELCHR.BAS"
  2. 20 INTEGER I
  3. 30 DIM Erase$[16]
  4. 40 COM /Setlabel/ INTEGER Erase
  5. 50 Erase=1
  6. 60 Erase$=" Erase  *ON/OFF "
  7. 70    !
  8. 80 CLEAR SCREEN
  9. 90 GINIT
  10. 100 GRAPHICS INPUT IS KBD,"KBD"
  11. 110 LORG 1
  12. 120   !
  13. 130 Set_grid(4)
  14. 140 Disp_chr(72)
  15. 150 Set_grid(3)
  16. 160 Disp_chr(103)
  17. 170 Draw_grid(2)
  18. 180 Show
  19. 190 Draw_grid(1)
  20. 200 OUTPUT KBD;"""LABELCHR Version 18-Dec-89"" E";
  21. 210   !
  22. 220 USER 1 KEYS
  23. 230 ON KEY 3 LABEL " Which    Grid?",1 CALL Grid
  24. 240 ON KEY 2 LABEL "Display   Char",1 CALL Disp
  25. 250 ON KEY 1 LABEL "Digitize  Char",1 CALL Digit
  26. 260 ON KEY 4 LABEL Erase$,1 GOSUB Toggle_erase
  27. 270 ON KEY 5 LABEL "  Show    Chars",1 CALL Show
  28. 280 FOR I=6 TO 7
  29. 290 ON KEY I LABEL "" GOSUB Dummy
  30. 300 NEXT I
  31. 310 ON KEY 8 LABEL "  EXIT" GOTO Exit
  32. 320 Idle: GOTO Idle
  33. 330   !
  34. 340   !
  35. 350 Dummy: RETURN
  36. 360   !
  37. 370   !
  38. 380 Toggle_erase: Erase= NOT Erase
  39. 390 Erase$[9;1]=CHR$(32+10*Erase)
  40. 400 Erase$[16;1]=CHR$(42-10*Erase)
  41. 410 ON KEY 4 LABEL Erase$,1 GOSUB Toggle_erase
  42. 420 RETURN
  43. 430   !
  44. 440   !
  45. 450 Exit: USER 2 KEYS
  46. 460 END
  47. 470   !
  48. 480   !
  49. 490 SUB Grid
  50. 500 INTEGER G
  51. 510 INPUT "Which grid do you wish to use?",G
  52. 520 IF G<1 OR G>4 THEN 510
  53. 530 Set_grid(G)
  54. 540 SUBEND
  55. 550   !
  56. 560   !
  57. 570 SUB Disp
  58. 580 INTEGER C
  59. 590 DIM L$[20]
  60. 600     !
  61. 610 INPUT "Which character do you wish to display?",L$
  62. 620 IF LEN(L$)=1 THEN
  63. 630  C=NUM(L$)
  64. 640 ELSE
  65. 650  C=VAL(L$)
  66. 660  IF C<0 OR C>255 THEN 610
  67. 670 END IF
  68. 680 Disp_chr(C)
  69. 690 SUBEND
  70. 700   !
  71. 710   !
  72. 720 SUB Draw_grid(INTEGER Grid)
  73. 730 Set_grid(Grid)
  74. 740 PEN 6
  75. 750 GRID 1,1
  76. 760 SUBEND
  77. 770   !
  78. 780   !
  79. 790 SUB Set_grid(INTEGER Grid)
  80. 800 INTEGER G
  81. 810 G=Grid-1     ! zero base
  82. 820 W1=RATIO*25
  83. 830 W=W1*.95
  84. 840 H=2*W
  85. 850 VIEWPORT G*W1,G*W1+W,99-H,99
  86. 860 WINDOW 0,7,0,15
  87. 870 DISP "Grid =";Grid
  88. 880 SUBEND
  89. 890   !
  90. 900   !
  91. 910 SUB Disp_chr(INTEGER C)
  92. 920 COM /Setlabel/ INTEGER Erase
  93. 930 IF Erase THEN
  94. 940  MOVE 0,0
  95. 950  AREA PEN 0
  96. 960  RECTANGLE 8,16,FILL
  97. 970  PEN 6
  98. 980  GRID 1,1
  99. 990 END IF
  100. 1000 PEN 1
  101. 1010 MOVE -1,1
  102. 1020 CSIZE 2*RATIO*25*.95,.643
  103. 1030 LABEL CHR$(C);
  104. 1040 SUBEND
  105. 1050  !
  106. 1060  !
  107. 1070 SUB Digit
  108. 1080 INTEGER B,I,C
  109. 1090 DIM A$[60]
  110. 1100    !
  111. 1110 DISP "Mouse: Left=Draw, Right=Move   KBD:arrows, then ENTER, then MOVE/DRAW softkey"
  112. 1120 FOR I=1 TO 8
  113. 1130 ON KEY I LABEL "" GOSUB Dummy
  114. 1140 NEXT I
  115. 1150 PEN 2
  116. 1160 TRACK CRT IS ON
  117. 1170 MOVE 0,0
  118. 1180 SET LOCATOR 0,0
  119. 1190 A$=""
  120. 1200 LOOP
  121. 1210 DIGITIZE X,Y,S$
  122. 1220 EXIT IF S$[3;1]<>"2"
  123. 1230 B=VAL(S$[7,8])
  124. 1240 X=PROUND(X,0)
  125. 1250 Y=PROUND(Y,0)
  126. 1260 SET LOCATOR X,Y      ! set position for next DIGITIZE
  127. 1270 SET ECHO X,Y      ! move crosshairs here, now
  128. 1280      !
  129. 1290 SELECT B
  130. 1300 CASE 0
  131. 1310  ON KEY 5 LABEL "  Draw",2 GOTO Draw
  132. 1320  ON KEY 6 LABEL "  Move",2 GOTO Move
  133. 1330  ON KEY 8 LABEL "Digitize  Done",2 GOTO Done
  134. 1340  GOTO 1340
  135. 1350 Draw: DRAW X,Y
  136. 1360  C=SHIFT(X,-4)+Y
  137. 1370  GOTO 1400
  138. 1380 Move: MOVE X,Y
  139. 1390  C=128+SHIFT(X,-4)+Y
  140. 1400  ON KEY 5 LABEL "" GOSUB Dummy
  141. 1410  ON KEY 6 LABEL "" GOSUB Dummy
  142. 1420  ON KEY 8 LABEL "" GOSUB Dummy
  143. 1430 CASE 1,3
  144. 1440  GOTO Draw
  145. 1450 CASE 2
  146. 1460  GOTO Move
  147. 1470 END SELECT
  148. 1480 DISP C;" ";
  149. 1490 A$=A$&CHR$(C)
  150. 1500 END LOOP
  151. 1510 Done: SET ECHO -100,-100
  152. 1520 INPUT "What char do you wish to assign this definition to? (-1=Don't assign)",C
  153. 1530 IF C>=0 AND C<256 THEN CONFIGURE LABEL C TO A$
  154. 1540 SUBEXIT
  155. 1550 Dummy: BEEP
  156. 1560 RETURN
  157. 1570 SUBEND
  158. 1580  !
  159. 1590  !
  160. 1600 SUB Show
  161. 1610 INTEGER I
  162. 1620    !
  163. 1630 PEN 1
  164. 1640 CSIZE 2*RATIO*25*.95/16,.643
  165. 1650 CLIP OFF
  166. 1660 FOR I=128 TO 255
  167. 1670 MOVE INT((I-128)/16),14-I MOD 16
  168. 1680 LABEL CHR$(I);
  169. 1690 NEXT I
  170. 1700 CLIP ON
  171. 1710 SUBEND
  172.